home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / NRPAS13 / FRPRMN.DEM < prev    next >
Text File  |  1991-04-29  |  2KB  |  68 lines
  1. PROGRAM d10r9(input,output);
  2. (* driver for routine FRPRMN *)
  3. CONST
  4.    ndim=3;
  5.    ftol=1.0e-6;
  6.    pio2=1.5707963;
  7. TYPE
  8.    glnarray = ARRAY [1..ndim] OF real;
  9.    glndim=glnarray;
  10. VAR
  11.    ncom : integer;
  12.    pcom,xicom : glnarray; 
  13.    angl,fret : real;
  14.    iter,k : integer;
  15.    p : glnarray;
  16.  
  17. (*$I MODFILE.PAS *)
  18. (*$I BESSJ0.PAS *)
  19.  
  20. (*$I BESSJ1.PAS *)
  21.  
  22. FUNCTION fnc(x: glnarray): real;
  23. BEGIN
  24.    fnc := 1.0-bessj0(x[1]-0.5)*bessj0(x[2]-0.5)*bessj0(x[3]-0.5)
  25. END;
  26.  
  27. PROCEDURE dfnc(x: glnarray; VAR df: glnarray);
  28. BEGIN
  29.    df[1] := bessj1(x[1]-0.5)*bessj0(x[2]-0.5)*bessj0(x[3]-0.5);
  30.    df[2] := bessj0(x[1]-0.5)*bessj1(x[2]-0.5)*bessj0(x[3]-0.5);
  31.    df[3] := bessj0(x[1]-0.5)*bessj0(x[2]-0.5)*bessj1(x[3]-0.5)
  32. END;
  33.  
  34. (*$I F1DIM.PAS *)
  35.  
  36. FUNCTION func(x: real): real;
  37. BEGIN
  38.    func := f1dim(x)
  39. END;
  40.  
  41. (*$I MNBRAK.PAS *)
  42.  
  43. (*$I BRENT.PAS *)
  44.  
  45. (*$I LINMIN.PAS *)
  46.  
  47. (*$I FRPRMN.PAS *)
  48.  
  49. BEGIN
  50.    writeln('Program finds the minimum of a function');
  51.    writeln('with different trial starting vectors.');
  52.    writeln('True minimum is (0.5,0.5,0.5)');
  53.    FOR k := 0 to 4 DO BEGIN
  54.       angl := pio2*k/4.0;
  55.       p[1] := 2.0*cos(angl);
  56.       p[2] := 2.0*sin(angl);
  57.       p[3] := 0.0;
  58.       writeln;
  59.       writeln('Starting vector: (',
  60.          p[1]:6:4,',',p[2]:6:4,',',p[3]:6:4,')');
  61.       frprmn(p,ndim,ftol,iter,fret);
  62.       writeln('Iterations:',iter:3);
  63.       writeln('Solution vector: (',
  64.          p[1]:6:4,',',p[2]:6:4,',',p[3]:6:4,')');
  65.       writeln('Func. value at solution',fret:14)
  66.    END
  67. END.
  68.